home *** CD-ROM | disk | FTP | other *** search
/ Light ROM 1 / LIGHT-ROM 1 (Amiga Library Services)(1994).iso / ffdisks / d880.lha / Oberon / O3Demo2.lzh / Examples / Amok.mod < prev    next >
Text File  |  1993-01-15  |  8KB  |  340 lines
  1. (*---------------------------------------------------------------------------
  2.  
  3.     Kleines 3D-Demo
  4.  
  5.  
  6.     An einem Sonntag Vor(!)mittag geschrieben.
  7.  
  8.  
  9.     (Es ist doch etwas aus meiner 3D-Grafik-Zeit hängengeblieben)
  10.  
  11.  
  12.   --- Fridtjof.
  13.  
  14.  
  15.   :Program.   Amok
  16.   :Contents.  Kleines 3D-Demo
  17.   :Version.   V1.0, Dezember 89, Fridtjof Siebert
  18.   :Version.   V1.1, Juni     90, Fridtjof Siebert, Now uses Array-Constants
  19.   :Author.    Fridtjof Siebert
  20.   :Address.   Nobileweg 67, D-7000 Suttgart 40
  21.   :CopyRight. PD
  22.   :Language.  OBERON
  23.   :Compiler.  AMOK OBORON Compiler, V0.2 beta
  24.  
  25. ---------------------------------------------------------------------------*)
  26.  
  27. MODULE Amok;
  28.  
  29. (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)
  30.  
  31.  
  32. IMPORT g   := Graphics,
  33.        I   := Intuition,
  34.        e   := Exec,
  35.        d   := Dos;
  36.  
  37. CONST
  38.   PointCnt = 19;
  39.   LineCnt  = 14;
  40.   Auge   = 200;
  41.  
  42. TYPE
  43.   Point  = ARRAY 3 OF LONGINT;      (* x, y und z Koordinate      *)
  44.   Point2D= STRUCT x,y: INTEGER;     (* Koordinaten auf Bildschirm *)
  45.                   in:  BOOLEAN;     (* innerhalb des Schirms?     *)
  46.                   dummy: INTEGER;   (* nur, damit size=2^3 (speed)*)
  47.            END;
  48.   SPoint = ARRAY 3 OF INTEGER;
  49.   Line   = ARRAY 2 OF INTEGER;      (* Start- und Endpunkt        *)
  50.   Matrix = ARRAY 3, 3 OF LONGINT;   (* Abbildematrix (Festpunktintegers) *)
  51.  
  52.   PArray  = ARRAY PointCnt OF Point;
  53.   SPArray = ARRAY PointCnt OF SPoint;
  54.   LArray  = ARRAY LineCnt  OF Line;
  55.  
  56.   FourMatrices = ARRAY 4 OF Matrix;
  57.  
  58. VAR
  59.   CurMat: Matrix;
  60.  
  61.   Points:    PArray;
  62.   AbbPoints: ARRAY PointCnt OF Point2D; (* Abgebildete Punkte *)
  63.  
  64.   count, c2: INTEGER;           (* Zählt Abbildungen *)
  65.  
  66.   ns: I.NewScreen;
  67.   nw: I.NewWindow;
  68.   screen: I.ScreenPtr;
  69.   window: I.WindowPtr;
  70.   rp1,rp2: g.RastPortPtr;
  71.   Width  : INTEGER;
  72.   Height : INTEGER;
  73.   MitteX : INTEGER;
  74.   MitteY : INTEGER;
  75.  
  76.   BitMap: ARRAY 3 OF g.BitMapPtr;   (* 3-Fach gepuffert (Troublebuffering) *)
  77.   troubleBuf: INTEGER;              (* aktive BitMap                       *)
  78.  
  79.   AugeX: INTEGER;                   (* Augenposition                       *)
  80.   AugeY: INTEGER;
  81.  
  82. CONST
  83.  
  84.   SPoints = SPArray( -140,  40, 40, - 90,- 40, 40,
  85.                      - 90,  40, 40, -120,  10, 40,
  86.                      - 90,  10, 40, - 70,  40, 40,
  87.                      - 70,- 40, 40, - 40,   0, 40,
  88.                      - 10,- 40, 40, - 10,  40, 40,
  89.                        10,  40, 40,   50,  40, 40,
  90.                        50,- 40, 40,   10,- 40, 40,
  91.                        70,- 40, 40,   70,  40, 40,
  92.                       120,- 40, 40,   90,  10, 40,
  93.                       120,  40, 40);
  94.  
  95.   Lines = LArray( 0, 1, 1, 2,
  96.                   3, 4, 5, 6,
  97.                   6, 7, 7, 8,
  98.                   8, 9, 10,11,
  99.                  11,12, 12,13,
  100.                  13,10, 14,15,
  101.                  15,16, 17,18);
  102.  
  103.   mats = FourMatrices(7FFFH,    0,    0,      (* Einheitsmatrix    *)
  104.                           0,7FFFH,    0,
  105.                           0,    0,7FFFH,
  106.  
  107.                       32642,    0, 2856,      (* Drehung um Y (5°) *)
  108.                           0,7FFFH,    0,
  109.                       -2856,    0,32642,
  110.  
  111.                       32642, 2856,    0,      (* Drehung um Z (5°) *)
  112.                       -2856,32642,    0,
  113.                           0,    0,7FFFH,
  114.  
  115.                       7FFFH,    0,    0,      (* Drehung um X (5°) *)
  116.                           0,32642, 2856,
  117.                           0,-2856,32642);
  118.  
  119.  
  120. (*-------------------------------------------------------------------------*)
  121.  
  122.  
  123. PROCEDURE MulVecMat(VAR E,V: Point; VAR M: Matrix);
  124. (* E := V * M *)
  125.  
  126. VAR
  127.   i: INTEGER;
  128.  
  129. BEGIN
  130.   i := 0;
  131.   REPEAT
  132.     E[i] := ASH( M[i,0]*V[0] + M[i,1]*V[1] + M[i,2]*V[2], -15);
  133.     INC(i);
  134.   UNTIL i=3;
  135. END MulVecMat;
  136.  
  137.  
  138.  
  139. PROCEDURE MulMat(VAR M0,M1: Matrix);
  140. (* M0 := M0 * M1 *)
  141.  
  142. VAR
  143.   i,j: INTEGER;
  144.   M,N: Matrix;
  145.  
  146. BEGIN
  147.  
  148.   M := M1; N := M0; i := 0;
  149.  
  150.   REPEAT
  151.     j := 0;
  152.     REPEAT
  153.       M0[i,j] := ASH( M[0,j]*N[i,0] + M[1,j]*N[i,1] + M[2,j]*N[i,2] ,-15);
  154.       INC(j);
  155.     UNTIL j=3;
  156.     INC(i);
  157.   UNTIL i=3;
  158.  
  159. END MulMat;
  160.  
  161.  
  162. (*-------------------------------------------------------------------------*)
  163.  
  164.  
  165.  
  166. PROCEDURE Abbilden;
  167.  
  168. VAR
  169.   c: INTEGER;
  170.   a: Point2D;
  171.   AbbPnt: Point;
  172.  
  173.   PROCEDURE GetAuge(c,mc: INTEGER): INTEGER;
  174.  
  175.   VAR Auge: INTEGER;
  176.  
  177.   BEGIN
  178.     Auge := c-mc;
  179.     IF    Auge<-mc THEN RETURN -mc
  180.     ELSIF Auge> mc THEN RETURN  mc
  181.                    ELSE RETURN Auge END;
  182.   END GetAuge;
  183.  
  184. BEGIN
  185.   AugeX := GetAuge(screen.mouseX,MitteX);
  186.   AugeY := GetAuge(screen.mouseY,MitteY);
  187.   c := 0;
  188.   WHILE c<PointCnt DO
  189.     MulVecMat(AbbPnt,Points[c],CurMat);
  190.     a.x := SHORT(Auge*(AbbPnt[0]-AugeX) DIV (Auge - AbbPnt[2])) + MitteX + AugeX;
  191.     a.y := SHORT(Auge*(AbbPnt[1]-AugeY) DIV (Auge - AbbPnt[2])) + MitteY + AugeY;
  192.     a.in := (a.x>=0) AND (a.x<Width) AND (a.y>=0) AND (a.y<Height);
  193.     AbbPoints[c] := a;
  194.     INC(c);
  195.   END;
  196. END Abbilden;
  197.  
  198.  
  199. PROCEDURE Zeichnen;
  200.  
  201. VAR
  202.   c,i: INTEGER;
  203.   a,b: Point2D;
  204.   rp: g.RastPortPtr;
  205.  
  206. BEGIN
  207.  
  208.   screen.viewPort.rasInfo.bitMap := BitMap[troubleBuf];
  209.   INC(troubleBuf); IF troubleBuf=3 THEN troubleBuf := 0 END;
  210.   rp1.bitMap := BitMap[troubleBuf];
  211.   rp2.bitMap := BitMap[troubleBuf];
  212.   I.MakeScreen(screen);
  213.  
  214. (* Achtung: Graphics.MrgCop() stürzt, wenn es von verschiedenen Tasks
  215.   gleichzeitig gerufen wird. Deshalb mach ich das so: *)
  216.  
  217.   e.Forbid();
  218.     g.MrgCop(I.ViewAddress());
  219.   e.Permit();
  220.  
  221.   g.SetAPen(rp1,0);
  222.   g.RectFill(rp1,0,0,Width-1,Height-1);
  223.   g.SetAPen(rp1,1);
  224.   g.SetAPen(rp2,1);
  225.  
  226.   c := 0;
  227.   WHILE c<LineCnt DO
  228.     a := AbbPoints[Lines[c,0]];
  229.     b := AbbPoints[Lines[c,1]];
  230.     rp := rp2;
  231.     IF a.in AND b.in THEN rp := rp1 END;
  232.     g.Move(rp,a.x,a.y);
  233.     g.Draw(rp,b.x,b.y);
  234.     INC(c);
  235.   END;
  236.  
  237. END Zeichnen;
  238.  
  239.  
  240. (*-------------------------------------------------------------------------*)
  241.  
  242.  
  243. PROCEDURE OpenScreen;
  244.  
  245. VAR
  246.   c: INTEGER;
  247.  
  248. BEGIN
  249.  
  250.   Width  := g.gfx.normalDisplayColumns DIV 32 * 16;
  251.   Height := g.gfx.normalDisplayRows;
  252.  
  253.   MitteX := Width  DIV 2;
  254.   MitteY := Height DIV 2;
  255.  
  256.   c := 0;
  257.   WHILE c<3 DO
  258.     NEW(BitMap[c]);
  259.     g.InitBitMap(BitMap[c]^,1,Width,Height);
  260.     BitMap[c].planes[0] := g.AllocRaster(Width,Height);
  261.     IF g.gfx.libNode.version>=36 THEN
  262.       g.BltClear(BitMap[c].planes[0],BitMap[c].bytesPerRow+10000H*BitMap[c].rows,LONGSET{1});
  263.     ELSE
  264.       g.BltClear(BitMap[c].planes[0],BitMap[c].bytesPerRow*BitMap[c].rows,LONGSET{});
  265.     END;
  266.     IF BitMap[c].planes[0]=NIL THEN HALT(0) END;
  267.     INC(c);
  268.   END;
  269.   troubleBuf := 0;
  270.  
  271.   ns.width       := Width;
  272.   ns.height      := Height;
  273.   ns.depth       := 1;
  274.   ns.type        := I.customScreen + {I.customBitMap};
  275.   ns.customBitMap:= BitMap[0];
  276.   screen := I.OpenScreen(ns);
  277.   IF screen=NIL THEN HALT(0) END;
  278.   rp1 := I.ScreenToRastPort(screen);
  279.  
  280.   nw.width      := screen.width;
  281.   nw.height     := screen.height;
  282.   nw.idcmpFlags := LONGSET{I.closeWindow};
  283.   nw.flags      := LONGSET{I.windowClose,I.borderless};
  284.   nw.screen     := screen;
  285.   nw.type       := I.customScreen;
  286.   window := I.OpenWindow(nw);
  287.   IF window=NIL THEN HALT(0) END;
  288.  
  289.   rp2 := window.rPort;
  290.  
  291. END OpenScreen;
  292.  
  293.  
  294. (*-------------------------------------------------------------------------*)
  295.  
  296.  
  297. BEGIN
  298.  
  299.   OpenScreen;
  300.  
  301.   count := 0;
  302.   REPEAT
  303.     c2 := 0;
  304.     REPEAT
  305.       Points[count,c2] := SPoints[count,c2];
  306.       INC(c2);
  307.     UNTIL c2=3;
  308.     INC(count);
  309.   UNTIL count=PointCnt;
  310.  
  311.   count := 143; c2 := 0;
  312.  
  313.   REPEAT
  314.     INC(count);
  315.  
  316.     IF count=144 THEN count := 0;
  317.                       CurMat := mats[0];
  318.                       INC(c2); IF c2=4 THEN c2 := 0 END;
  319.                  ELSE MulMat(CurMat,mats[c2]) END;
  320.     Abbilden;
  321.     Zeichnen;
  322.  
  323.   UNTIL e.GetMsg(window.userPort)#NIL;
  324.  
  325. CLOSE
  326.  
  327.   IF window#NIL THEN I.CloseWindow(window) END;
  328.   IF screen#NIL THEN I.OldCloseScreen(screen) END;
  329.   g.WaitBlit;
  330.   count := 0;
  331.   REPEAT
  332.     IF BitMap[count].planes[0]#NIL THEN g.FreeRaster(BitMap[count].planes[0],Width,Height) END;
  333.     INC(count);
  334.   UNTIL count=3;
  335.  
  336. END Amok.
  337.  
  338.  
  339.  
  340.